home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
virtmem.exe
/
MEMMOVER.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-10-09
|
6KB
|
266 lines
Unit MemMOver;
{$O+}
{Unit that overrides (overloads) basic memory management routines used by
units Pull, Wndw, and Qwik, to allow PRICE86 more control over the heap.}
Interface
Type
ST4=String[4];
ST9=String[9];
PointerTractPtr=^PointerTractRec;
PointerTractRec=
Record
PhysicalPoint:Pointer;
VirtualPoint :LongInt;
Size :Word;
Next :LongInt{PointerTractRec};
End;
Var
PointerTract:LongInt{PointerTractPtr};
Procedure New (var P:Pointer);
Procedure Dispose (var P:Pointer);
Procedure Mark (var P:Pointer);
Procedure Release (var P:Pointer);
Procedure GetMem (var P ; Size:Word);
Procedure FreeMem (var P ;Size:Word);
Function MaxAvail:LongInt;
Function MemAvail:LongInt;
Procedure InitPseudoHeap;
Function PointerString(CoolPoint:Pointer):ST9;
Function PointerTractPtrR(Virt : LongInt; Mucky : Integer):PointerTractPtr;
{*****************************************************************************}
Implementation
Uses VirtuMem;{,ErrorEra;}
{--------------------}
Function PointerTractPtrR(Virt : LongInt; Mucky : Integer):PointerTractPtr;
Var Temp:PointerTractPtr;
BEGIN
Temp:=PointerTractPtr(R(Virt,Mucky));
PointerTractPtrR:=Temp;
END;
{--------------------}
{Hex_String}
{ The function Hex_String converts an Word into a four
character hexadecimal number(string) with leading zeroes. }
Function Hex_String(Number: Word): ST4;
Function Hex_Char(Number: Word): Char;
Begin
If Number<10 then
Hex_Char:=Char(Number+48)
else
Hex_Char:=Char(Number+55);
end; { Function Hex_Char }
Var
S: ST4;
Begin
S:='';
S:=Hex_Char( (Number shr 1) div 2048);
Number:=( ((Number shr 1) mod 2048) shl 1)+
(Number and 1) ;
S:=S+Hex_Char(Number div 256);
Number:=Number mod 256;
S:=S+Hex_Char(Number div 16);
Number:=Number mod 16;
S:=S+Hex_Char(Number);
Hex_String:=S+'h';
end; { Function Hex_String }
{---------------------}
{PointerString}
{Converts a pointer to a 9 character string for display purposes.}
Function PointerString(CoolPoint:Pointer):ST9;
BEGIN
PointerString:=Hex_String(Seg(CoolPoint^))+':'+Hex_String(Ofs(CoolPoint^));
END;
{--------------------}
Procedure New (var P:Pointer);
BEGIN
Writeln('Unimplemented: "New"');
END;
{--------------------}
Procedure Dispose (var P:Pointer);
BEGIN
Writeln('Unimplemented: "Dispose"');
END;
{--------------------}
Procedure Mark (var P:Pointer);
BEGIN
Writeln('Unimplemented: "Mark"');
END;
{--------------------}
Procedure Release (var P:Pointer);
BEGIN
Writeln('Unimplemented: "Release"');
END;
{--------------------}
{Track}
{Inserts a record to keep track of the virtual pointer corresponding to the
physical one. Uses PointerTract as a global.}
Procedure Track(VirtuPointer:LongInt;
PhysiPointer:Pointer;
Bigness :Word);
Var
NewOne:LongInt;
BEGIN
NewOne:=ANew(SizeOf(PointerTractRec));
With PointerTractPtrR(NewOne,Stay)^ do
Begin
VirtualPoint:=VirtuPointer;
PhysicalPoint:=PhysiPointer;
Size:=Bigness;
Next:=PointerTract;
End;
Unstay(NewOne);
PointerTract:=NewOne;
END;
{--------------------}
{FindStat}
{This function returns the record containing the virtual pointer (and other
info) that coresponds to the physical pointer input parameter. Use
PointerTract global. Returns Null if not found.}
Function FindStat(P:Pointer):LongInt{PointerTractPtr};
Var
Current:LongInt{PointerTractPtr};
BEGIN
Current:=PointerTract;
While (Current<>Null) and
(PointerTractPtrR(Current,Clen)^.PhysicalPoint<>P) do
Current:=PointerTractPtrR(Current,Clen)^.Next;
FindStat:=Current;
END;
{--------------------}
{Untrack}
{Deletes the record that keeps track of the block with VirtuPoint being
the virtual pointer. Depossess the block. Block is assumed to exist.
PointerTract used globally.}
Procedure Untrack(VirtuPoint:LongInt);
Var
Current :LongInt{PointerTractPtr};
Previous:LongInt{PointerTractPtr};
BEGIN
Previous:=Null;
Current:=PointerTract;
While (Current<>Null) and
(PointerTractPtrR(Current,Clen)^.VirtualPoint<>VirtuPoint) do
Begin
Previous:=Current;
Current:=PointerTractPtrR(Current,Clen)^.Next;
End;
If (Previous=Null) then
PointerTract:=PointerTractPtrR(Current,Clen)^.Next
Else
PointerTractPtrR(Previous,Dirt)^.Next:=PointerTractPtrR(Current,Clen)^.
Next;
Depossess(Current,SizeOf(PointerTractRec));
END;
{--------------------}
{GetMem}
Procedure GetMem (var P ; Size:Word);
Var
VirtuPointer:LongInt;
BEGIN
VirtuPointer:=ANew(Size);
Pointer(P):=R(VirtuPointer,Stay);
Track(VirtuPointer,Pointer(P),Size);
END;
{--------------------}
{FreeMem}
Procedure FreeMem (var P ;Size:Word);
Var
PointerStat:LongInt{PointerTractPtr};
BEGIN
PointerStat:=FindStat(Pointer(P));
If (PointerStat=Null) then
WriteLn('PointerStat is null.');
If (PointerTractPtrR(PointerStat,Clen)^.Size<>Size) then
WriteLn('Wrong size.');
With PointerTractPtrR(PointerStat,Stay)^ do
Begin
Unstay(VirtualPoint);
Depossess(VirtualPoint,Size);
Untrack(VirtualPoint);
End;
Unstay(PointerStat);
END;
{--------------------}
Function MaxAvail:LongInt;
BEGIN
MaxAvail:=PageSize;
END;
{--------------------}
Function MemAvail:LongInt;
BEGIN
MemAvail:=PageSize;
END;
{---------------------}
Procedure InitPseudoHeap;
BEGIN
PointerTract:=Null;
END;
{--------------------}
END.